home *** CD-ROM | disk | FTP | other *** search
/ Aminet 5 / Aminet 5 - March 1995.iso / Aminet / dev / basic / RIBlitzLibs.lha / riblitzlibs / examples / ZoomWindow.asc < prev   
Encoding:
Text File  |  1995-01-28  |  5.7 KB  |  229 lines
  1. ; RI Zoomer
  2. ; (C)1994 Reflective Images
  3. ; By Stephen NcNamara
  4. ; Uses: FX-library
  5. ;       FNS-library
  6. ; Make sure you have these installed before you try compiling this program.
  7. ; Demonstrates: Using ZoomXn commands, FNS printing commands.
  8.  
  9. DEFTYPE.w windh,windw,windwmod,azoom,bzoom,azoom2,azoom3,bzoom3
  10.  
  11. Statement WBackFill{winnum.b,gadsize.w}
  12.   ad.l=RastPort(winnum)
  13.   Poke.l ad+8,?mypattern
  14.   Poke.b ad+$1d,1
  15.  
  16.   Use Window winnum
  17.   x1.w=WLeftOff
  18.   y1.w=WTopOff
  19.   x2.w=x1+InnerWidth-4
  20.   y2.w=y1+InnerHeight-gadsize
  21.   WBox x1,y1,x2+4,y1+1,2         ; Top 2 pixels
  22.  
  23.   WBox x1,y1,x1+3,y2,2           ; Left 4 pixels
  24.  
  25.   WBox x2+1,y1,x2+4,y2,2         ; Right 4 pixels
  26.  
  27.   WBox x1,y2+1,x2+4,y2+gadsize,2 ; Bottom area
  28.  
  29.   Poke.l ad+8,0
  30.   Poke.b ad+$1d,0
  31.  
  32.   Wline x1+4,y2,x1+4,y1+2,x2,y1+2,1
  33.   Wline x2,y1+2,x2,y2,x1+4,y2,2
  34.  
  35.   Statement Return
  36.  
  37. mypattern:  Dc.w $aaaa
  38.             Dc.w $5555
  39. End Statement
  40.  
  41. NoCli
  42. AMIGA
  43.  
  44. WBStartup
  45. WbToScreen 0                                  ; get Workbench as screen 0
  46. ShowScreen 0                                  ; bring it to the front
  47. ScreensBitMap 0,0                             ; get the bitmap
  48. Use BitMap 0 : BitMapOutput 0
  49.  
  50. deep.b=Peek.b(Addr BitMap(0)+5)               ; get Workbench depth
  51. If deep<1 Then BeepScreen 0 : End             ; if error then end
  52.  
  53. BitMap 1,320,256,deep                         ; get a couple of bitmaps
  54. BitMap 2,640,512,deep
  55.  
  56. BorderPens 2,1
  57.  
  58. Use Screen 0
  59. ad.l=Peek.l(Addr Screen(0))
  60. scrw.l=Peek.w(ad+12)                          ; Workbench width
  61. scrh=Peek.w(ad+14)                            ; Workbench height
  62.  
  63. MenuTitle 0,0,"Zoomer"
  64. MenuItem 0,1,0,0,"  Zoom X2 display       ","1"
  65. MenuItem 0,1,0,1,"  Zoom X4 display       ","2"
  66. MenuItem 0,1,0,2,"  Zoom X8 display       ","3"
  67. MenuItem 0,0,0,3,"========================" : MenuState 0,0,3,Off
  68. MenuItem 0,0,0,4,"Program info ","H"
  69. MenuItem 0,0,0,5,"Quit and die ","Q"
  70. MenuTitle 0,1,"Preferences"
  71. MenuItem 0,%1,1,0,"  Coordinates     ","C"
  72. MenuItem 0,%1,1,1,"  Crosshairs     ","X"
  73.  
  74. SizeLimits 64,64,640,512
  75. Window 0,487,22,153,64,$1|$2|$4|$8|$10|$20|$40|$200|$400|$1000|$200000,"RI Zoom window (X2)",1,2,0
  76. SetMenu 0
  77.  
  78. zoom.w=2 : zoommenu=0
  79. Gosub UpdateWind
  80. Repeat
  81.   ev.l=Event : evw.l=EventWindow
  82.   If evm=0
  83.     If ev=4 OR ev=2
  84.       Use BitMap 2 : BitMapOutput 2
  85.       Cls
  86.       Use Window 0 : WCls
  87.       Use BitMap 0 : BitMapOutput 0
  88.       Gosub UpdateWind
  89.     EndIf
  90.     If ev=64 AND GadgetHit=0 AND info
  91.       Gosub RemoveInfo
  92.     EndIf
  93.     If ev=256 AND MenuHit=0
  94.       oldzoom.w=zoom
  95.       oldzoommenu=zoommenu
  96.       Select ItemHit
  97.         Case 0
  98.           zoom=2 : zoommenu=0
  99.         Case 1
  100.           zoom=4 : zoommenu=1
  101.         Case 2
  102.           zoom=8 : zoommenu=2
  103.         Case 4
  104.           Gosub About
  105.         Case 5
  106.           End
  107.       End Select
  108.       If zoom=oldzoom
  109. ;        If MenuChecked(0,0,zoommenu)=0 Then MenuList 0,0,zoommenu
  110. ;      Else
  111. ;        If MenuChecked(0,0,oldzoommenu) Then MenuList 0,0,oldzoommenu
  112. ;        If MenuChecked(0,0,zoommenu)=0 Then MenuList 0,0,zoommenu
  113.       EndIf
  114.       If oldzoom<>zoom
  115.         Use BitMap 2 : BitMapOutput 2
  116.         Cls
  117.         Use Window 0 : WCls
  118.         Gosub UpdateTitle
  119.         Gosub UpdateWind
  120.       EndIf
  121.     EndIf
  122.     If ev=256 AND MenuHit=1
  123.       Select ItemHit
  124.         Case 0
  125.           coords=MenuChecked(0,1,0)
  126.           If coords=0 Then Gosub UpdateTitle
  127.         Case 1
  128.           crosshairs.b=MenuChecked(0,1,1)
  129.       End Select
  130.     EndIf
  131.   EndIf
  132.  
  133.   Use BitMap 1 : BitMapOutput 1
  134.   xm.w=SMouseX : ym.w=SMouseY
  135.   x.w=xm-azoom3 : y.w=ym-bzoom3
  136.   If x<0 Then x=0
  137.   If y<0 Then y=0
  138.   If x>scrw-azoom Then x=scrw-azoom
  139.   If y>scrh-bzoom Then y=scrh-bzoom
  140.   Scroll x,y,azoom,bzoom,0,0,0
  141.   If crosshairs
  142.     Line xm-x,0,xm-x,bzoom-1,-1
  143.     Line 0,ym-y,azoom-1,ym-y,-1
  144.   EndIf
  145.   azoom2.w=Smallest(azoom+8,320)
  146.   Select zoom
  147.     Case 2
  148.       ZoomX2 1,2,0,0,azoom2,bzoom
  149.     Case 4
  150.       ZoomX4 1,2,0,0,azoom2,bzoom
  151.     Case 8
  152.       ZoomX8 1,2,0,0,azoom2,bzoom
  153.   End Select
  154.   Use Window 0
  155.   If coords Then WTitle Str$(xm)+","+Str$(ym)
  156.   BitMaptoWindow 2,0,0,0,0,0,windwmod,windh
  157.   VWait
  158. Until ev=$200 AND evm=0
  159. End
  160.  
  161. About:
  162.   If info=1 Then Return
  163.   FNSOutput 1,1                         ; set output to bitmap 1 and update CLIP
  164.   FNSPrefs %1,1                         ; centred text in colour 1
  165.   Use BitMap 1 : BitMapOutput 1 : Cls
  166.   FNSPrint 0,70,2,"Okay"                ; print in default font at 70,2
  167.   Line 0,0,139,0,2 : Line 139,11,1 : Line 0,11,1 : Line 0,0,2
  168.   GetaShape 0,0,0,140,12
  169.  
  170.   Boxf 1,1,138,10,3
  171.   Line 0,0,139,0,1 : Line 139,11,2 : Line 0,11,2 : Line 0,0,1
  172.   FNSPrint 0,70,2,"Okay"                ; print in default font at 70,2
  173.   GetaShape 1,0,0,140,12
  174.  
  175.   Cls
  176.   Use BitMap 0 : BitMapOutput 0
  177.   Restore AboutInfo
  178.   Read num.w
  179.   Read a$
  180.   FNSPrint 0,160,2,a$,%111,1 : y.w=12   ; print title with underline & bold
  181.   For h=1 To num-1
  182.     Read a$
  183.     FNSPrint 0,160,y,a$
  184.     y+10
  185.   Next h
  186.   x.w=(ScreenWidth-320)/2 : y.w=(ScreenHeight-120)/2
  187.   ShapeGadget 0,160-70,118-6,0,0,0,1
  188.   Window 1,x,y,320,128,$11006,"Program Info",1,2,0
  189.   WBackFill{1,18}
  190.   x=160-70 : y=118-6
  191.   WBox x,y,x+139,y+11,0
  192.   WBlit 0,x,y
  193.   BitMaptoWindow 1,1,16,0,16,14,272,90
  194.   If coords=0 Then Gosub UpdateTitle
  195.   info=1
  196.   Return
  197.  
  198. RemoveInfo:
  199.   Free Window 1
  200.   Use Window 0
  201.   Activate 0
  202.   ev=0
  203.   Free GadgetList 0
  204.   info=0
  205. Return
  206.  
  207. UpdateTitle:
  208.   If coords=0 Then Use Window 0 : WTitle "RI Zoom Window (X"+Str$(zoom)+")"
  209. Return
  210.  
  211. UpdateWind:
  212.   Use Window 0
  213.   windw.w=InnerWidth
  214.   windh.w=InnerHeight
  215.   windwmod.w=windw-(windw MOD zoom)
  216.   azoom.w=(windw)/zoom
  217.   bzoom.w=(windh)/zoom
  218.   azoom3=azoom ASR 1
  219.   bzoom3=bzoom ASR 1
  220. Return
  221.  
  222. AboutInfo:
  223.   Data.w 9
  224.   Data$  "RI Zoomer v0.2","(C) 1994 Leading Edge Software",""
  225.   Data$  "Written in Blitz Basic 2 by","Stephen McNamara"
  226.   Data$  "EMAIL: SIS3149@SIS.PORT.AC.UK",""
  227.   Data$  "Using the Blitz 2 libraries developed by","L.E.S./R.I."
  228.  
  229.